# ======================================================================
#
# Copyright (C) ADN
# Server.pl
# Description:
#  - Serveur Socket SOAP
#  - Server Socket SOAP
#
# ======================================================================

use strict;
use threads;
use IO::Socket;
use ADN::LOG::Log;
use threads::shared;
use ADN::LANG::Lang;
use ADN::CONF::Read;
use ADN::XML::XMLtoOBJ;
use ADN::SERVER::Header;
use ADN::SERVER::WebGET;
use ADN::SERVER::WebHTML;
use ADN::SERVER::StartUP;
use ADN::SERVER::Constant qw(:constant :log);
use ADN::SERVER::ParsePID;
use ADN::SERVER::ParsePOST;

# #######################
# DEFINITION VAR
# #######################
my ( $log, $objheader, $objwebget,
		 $objpost, $objpid );
my ( %lang, %param );
my @proc : shared;

# #######################
# CATCH ERROR & PID
# #######################
ADN::SERVER::StartUP->pid();
#my $path = ADN::SERVER::StartUP->temp();
#open STDERR, ">> $path/error.log";

# #######################
# LOG & LANG
# #######################
$log = ADN::LOG::Log->new();
%lang = ADN::LANG::Lang->new()->server();

# #######################
# OBJECT HEADER WEBGET
# PARSEPOST
# #######################
$objheader = ADN::SERVER::Header->new( );
$objwebget = ADN::SERVER::WebGET->new( );
$objpost = ADN::SERVER::ParsePOST->new( );
$objpid = ADN::SERVER::ParsePID->new( );

_init();
_sock();

# #######################
# INIT SERVER SETTINGS
# #######################
sub _init {
  my %server;
  @proc = ADN::SERVER::StartUP::_start( $ARGV[0] );
  %server = ADN::CONF::Read->new()->server();
  %param = ( Address => $server{address},
	           Port => $server{port},
	           Http => 'http(80)',
	           Type => 'TCP',
	           Maxclient => 2,
	           Reuse => '1' );
  undef %server;
  $log->Log( $lang{mess1}, MED, ALL );
  return;
}

# #######################
# DEFINE THE SOCK
# #######################
sub _sock {
  my ( $sock, $nsock );
  $sock = IO::Socket::INET->new( PeerAddr => $param{Address},
				                         PeerPort => $param{Http},
				                         LocalPort => $param{Port},
				                         Proto => $param{Type},
				                         Listen => $param{Maxclient},
				                         ReuseAddr => $param{Reuse});
  die $lang{mess2} unless $sock;
  undef %param;
	threads->new(\&ADN::SERVER::StartUP::startsock)->detach;
	while ( $nsock = $sock->accept() ) {
		&ADN::SERVER::StartUP::cleanSchedule;
	  threads->new(\&threadSock, $nsock)->detach;
  }
  undef $sock; undef $nsock;
  return;
}

# #######################
# THE SOCK FOR TREATMENT
# #######################
sub threadSock {
  my ( $nsock, $header, $subt, $gid );
  my @arg;
  ( $nsock ) = @_;
  $log->Log( 'IP : ' . $nsock->peerhost, MED, TERM );
  $header = $objheader->start( Data => '', Nb => '202', Type => 'xml' );
  if ( $^O eq 'linux' || $^O eq 'darwin' ) {
     send($nsock, $header, 1);
  }
  while ( <$nsock> ) {
    if ( substr ( $_, 0, 6 ) eq '<soap:' ) {
	   serviceSOAP( $_, $gid, $objpost );
	   last;
    }
	  $log->Log( $_, MED, TERM );
	  @arg = split / /sm, $_;
	  if (defined $arg[0]) {
	    $subt = substr( $arg[0], 0, 3 );
		}
	  if ( $subt eq 'Con' && ($_ =~ s/^.*\w{6}\=\Wurn\:(\w*)\W.*$/$1/smx) ) {
		  $gid = $_;
		  chomp $gid;
	  }
	  if ( $subt eq 'GET' and defined $arg[1] ) {
	    $objwebget->start( Param => $arg[1],
				                 Nsock => $nsock,
				                 Proc => \@proc );
	    last;
	  }
	  if ( $^O eq 'MSWin32' ) {
	    send($nsock, $header, 1);
	  }
  }
  undef @arg; undef $header; undef $gid;
  if (!close $nsock) {}
}

# #######################
# FUNCTION TO USE THE SOAP
# #######################
sub serviceSOAP {
  my ( $service, $nameserv, $xml, $name, $nbr, $gid );
  my @id;
  ( $xml, $gid ) = @_;
  $log->Log( $lang{mess3}, LOW, TERM );
  $log->Log( 'XML : ' . $xml, HIGH, TERM );
  $service = ADN::XML::XMLtoOBJ->new( $xml );
  if ( $service != -1 ) {
	 $nameserv = $service->_nameracine();
	 @id = $service->IdClient();
	 $log->Log( 'SERVICE : ' . $nameserv, HIGH, ALL );
	 $log->Log( 'GROUPE : ' . $gid, HIGH, ALL );
	 $name = $objpost->start( Name => $nameserv,
	                          GID => $gid,
					                  XML => $xml );
	 $log->Log( 'PROCESS : ' . $name, HIGH, ALL );
	 push @proc, $name;
	 if ( $name eq '1' ) {
	   @proc = $objpid->start( Cmd => 'kill',
						                 Proc => \@proc,
						                 Name => $nameserv,
						                 ID => $id[0] );
	   $nbr = scalar @proc;
	   if ($proc[$nbr] == -1) {
		  $log->Log( $lang{mess6} . ' ' . $nameserv , HIGH, ALL );
	   }
	 }
	 if ( $name eq '-1' ) {
	    $log->Log( $lang{mess4} . ' ' . $nameserv , HIGH, ALL );
	 }
  }
  else {
	 $log->Log( $lang{mess5}, HIGH, ALL );
  }
	undef $nbr;	undef $xml;	undef $gid;	undef @id;
	undef $name; undef $nameserv; undef $service;
  return;
}
__END__
